Introdução

Import de bibliotecas:

library(tidyverse)
library(lubridate)
library(scales)
library(plotly)
library(forecast)
library(Metrics)
library(prophet)
theme_set(theme_gray())

Leitura do data-frame. Alguns valores de “;” causaram algum problema para abrir e foram substituidos por “:”. Os valores de “data_safra” são lidos como datas. Os valores ausentes (NA) no faturamento são imputados como zero (0).

df <- read.csv2(text=str_replace_all(readLines("base_case.csv", skip=1), "; ", ": ")) %>%
  mutate(data_safra = as.Date(data_safra)) %>%
  mutate(valor_faturamento = replace_na(valor_faturamento, 0)) %>%
  mutate(codigo_empresa = as.factor(codigo_empresa)) # Faz com que o código da empresa possa ser analisado como categoria posteriormente

Sumário de valores iniciais do data-frame.

summary(df)

Faturamento ao longo do tempo

p <- df %>%
  group_by(data_safra) %>%
  summarize(valor_faturamento=sum(valor_faturamento)) %>%
  ggplot(aes(x=data_safra, y=valor_faturamento)) +
  geom_line(size=1) +
  scale_y_continuous(labels = dollar_format()) +
  scale_x_date(date_breaks = "3 month", labels = date_format("%m-%Y")) +
  labs(x = "Data", y = "Faturamento") +
  theme(axis.text.x = element_text(angle = 45, hjust = 1))
ggplotly(p)

Ajuste linear para o faturamento para verificar a tendência e correlação.

p <- df %>%
  group_by(data_safra) %>%
  summarize(valor_faturamento=sum(valor_faturamento)) %>%
  ggplot(aes(x=data_safra, y=valor_faturamento)) +
  geom_line(size=0.4) +
  geom_smooth(method = lm) +
  scale_y_continuous(labels = dollar_format()) +
  scale_x_date(date_breaks = "3 month", labels = date_format("%m-%Y")) +
  labs(x = "Data", y = "Faturamento") +
  theme(axis.text.x = element_text(angle = 45, hjust = 1))
ggplotly(p)

Dados do ajuste:

lin_model <- df %>%
  group_by(data_safra) %>%
  summarize(valor_faturamento=sum(valor_faturamento)) %>%
  lm(formula = valor_faturamento  ~ data_safra)
summary(lin_model)
## 
## Call:
## lm(formula = valor_faturamento ~ data_safra, data = .)
## 
## Residuals:
##    Min     1Q Median     3Q    Max 
## -15636  -6218    394   4786  11405 
## 
## Coefficients:
##               Estimate Std. Error t value Pr(>|t|)    
## (Intercept) -1.161e+06  6.127e+04  -18.95   <2e-16 ***
## data_safra   8.135e+01  3.534e+00   23.02   <2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 6703 on 34 degrees of freedom
## Multiple R-squared:  0.9397, Adjusted R-squared:  0.9379 
## F-statistic: 529.8 on 1 and 34 DF,  p-value: < 2.2e-16

Faturamento por idade da empresa

df %>%
  group_by(st_idade_faixa) %>%
  summarize(valor_faturamento=sum(valor_faturamento)) %>%
  arrange(desc(valor_faturamento)) %>%
  mutate(st_idade_faixa = fct_reorder(st_idade_faixa, valor_faturamento)) %>%
  drop_na() %>%
  ggplot(aes(st_idade_faixa, valor_faturamento, fill = st_idade_faixa)) +
  geom_col() +
  coord_flip() +
  theme(legend.position = "none") +
  labs(x="", y="Faturamento") +
  scale_y_continuous(labels = dollar_format())

df %>%
  group_by(st_idade_faixa) %>%
  summarize(valor_faturamento=sum(valor_faturamento)) %>%
  arrange(desc(valor_faturamento)) %>%
  mutate(st_idade_faixa = fct_reorder(st_idade_faixa, valor_faturamento)) %>%
  drop_na() %>%
  view()

Qual faixa de funcionários tem maior faturamento no total?

df %>%
  group_by(st_funcionariosfaixa) %>%
  summarize(valor_faturamento=sum(valor_faturamento)) %>%
  arrange(desc(valor_faturamento)) %>%
  mutate(st_funcionariosfaixa = fct_reorder(st_funcionariosfaixa, valor_faturamento)) %>%
  drop_na() %>%
  head(10) %>%
  ggplot(aes(st_funcionariosfaixa, valor_faturamento, fill = st_funcionariosfaixa)) +
  geom_col() +
  coord_flip() +
  theme(legend.position = "none") +
  labs(x="", y="Faturamento") +
  scale_y_continuous(labels = dollar_format())

df %>%
  group_by(st_funcionariosfaixa) %>%
  summarize(valor_faturamento=sum(valor_faturamento)) %>%
  arrange(desc(valor_faturamento)) %>%
  mutate(st_funcionariosfaixa = fct_reorder(st_funcionariosfaixa, valor_faturamento)) %>%
  drop_na() %>%
  head(10) %>%
  view()

Faturamento por mesorregião

df %>%
  group_by(st_mesorregiao) %>%
  summarize(valor_faturamento=sum(valor_faturamento)) %>%
  arrange(desc(valor_faturamento)) %>%
  mutate(st_mesorregiao=fct_reorder(st_mesorregiao, valor_faturamento)) %>%
  drop_na() %>%
  head(5) %>%
  ggplot(aes(st_mesorregiao, valor_faturamento, fill = st_mesorregiao)) +
  geom_col() +
  coord_flip() +
  theme(legend.position = "none") +
  labs(x="", y="Faturamento") +
  scale_y_continuous(labels = dollar_format())

df %>%
  group_by(st_mesorregiao) %>%
  summarize(valor_faturamento=sum(valor_faturamento)) %>%
  arrange(desc(valor_faturamento)) %>%
  mutate(st_mesorregiao=fct_reorder(st_mesorregiao, valor_faturamento)) %>%
  drop_na() %>%
  head(5) %>%
  view()

Faturamento por microrregião

df %>%
  group_by(st_microrregiao) %>%
  summarize(valor_faturamento=sum(valor_faturamento)) %>%
  arrange(desc(valor_faturamento)) %>%
  mutate(st_microrregiao=fct_reorder(st_microrregiao, valor_faturamento)) %>%
  drop_na() %>%
  head(10) %>%
  ggplot(aes(st_microrregiao, valor_faturamento, fill = st_microrregiao)) +
  geom_col() +
  coord_flip() +
  theme(legend.position = "none") +
  labs(x="", y="Faturamento") +
  scale_y_continuous(labels = dollar_format())

df %>%
  group_by(st_microrregiao) %>%
  summarize(valor_faturamento=sum(valor_faturamento)) %>%
  arrange(desc(valor_faturamento)) %>%
  mutate(st_microrregiao=fct_reorder(st_microrregiao, valor_faturamento)) %>%
  drop_na() %>%
  head(10) %>%
  view()

Faturamento por st_subclassecnae

# CNAE: Classificação Nacional de Atividades Econômicas

df %>%
  group_by(st_subclassecnae) %>%
  summarize(valor_faturamento=sum(valor_faturamento)) %>%
  arrange(desc(valor_faturamento)) %>%
  mutate(st_subclassecnae=fct_reorder(st_subclassecnae, valor_faturamento)) %>%
  drop_na() %>%
  head(10) %>%
  ggplot(aes(st_subclassecnae, valor_faturamento, fill = st_subclassecnae)) +
  geom_col() +
  coord_flip() +
  theme(legend.position = "none") +
  labs(x="", y="Faturamento") +
  scale_y_continuous(labels = dollar_format())

df %>%
  group_by(st_subclassecnae) %>%
  summarize(valor_faturamento=sum(valor_faturamento)) %>%
  arrange(desc(valor_faturamento)) %>%
  mutate(st_subclassecnae=fct_reorder(st_subclassecnae, valor_faturamento)) %>%
  drop_na() %>%
  head(10) %>%
  view()

Faturamento por st_classecnae

df %>%
  group_by(st_classecnae) %>%
  summarize(valor_faturamento=sum(valor_faturamento)) %>%
  arrange(desc(valor_faturamento)) %>%
  mutate(st_classecnae=fct_reorder(st_classecnae, valor_faturamento)) %>%
  drop_na() %>%
  head(10) %>%
  ggplot(aes(st_classecnae, valor_faturamento, fill = st_classecnae)) +
  geom_col() +
  coord_flip() +
  theme(legend.position = "none") +
  labs(x="", y="Faturamento") +
  scale_y_continuous(labels = dollar_format())

Faturamento por st_grupocnae

df %>%
  group_by(st_grupocnae) %>%
  summarize(valor_faturamento=sum(valor_faturamento)) %>%
  arrange(desc(valor_faturamento)) %>%
  mutate(st_grupocnae=fct_reorder(st_grupocnae, valor_faturamento)) %>%
  drop_na() %>%
  head(10) %>%
  ggplot(aes(st_grupocnae, valor_faturamento, fill = st_grupocnae)) +
  geom_col() +
  coord_flip() +
  theme(legend.position = "none") +
  labs(x="", y="Faturamento") +
  scale_y_continuous(labels = dollar_format())

Faturamento por st_divisaocnae

df %>%
  group_by(st_divisaocnae) %>%
  summarize(valor_faturamento=sum(valor_faturamento)) %>%
  arrange(desc(valor_faturamento)) %>%
  mutate(st_divisaocnae=fct_reorder(st_divisaocnae, valor_faturamento)) %>%
  drop_na() %>%
  head(10) %>%
  ggplot(aes(st_divisaocnae, valor_faturamento, fill = st_divisaocnae)) +
  geom_col() +
  coord_flip() +
  theme(legend.position = "none") +
  labs(x="", y="Faturamento") +
  scale_y_continuous(labels = dollar_format())

Faturamento por codigo_empresa e st_divisaocnae

df %>%
  group_by(codigo_empresa) %>%
  summarize(valor_faturamento=sum(valor_faturamento), cat = unique(st_divisaocnae)) %>%
  arrange(desc(valor_faturamento)) %>%
  mutate(codigo_empresa=fct_reorder(codigo_empresa, valor_faturamento)) %>%
  # drop_na() %>%
  head(10) %>%
  ggplot(aes(codigo_empresa, valor_faturamento, fill = cat)) +
  geom_col() +
  coord_flip() +
  labs(x="", y="Faturamento") +
  scale_y_continuous(labels = dollar_format()) +
  theme(legend.position="bottom") +
  guides(fill=guide_legend(nrow=5, byrow=TRUE))

df %>%
  group_by(codigo_empresa) %>%
  summarize(valor_faturamento=sum(valor_faturamento), cat = unique(st_divisaocnae)) %>%
  arrange(desc(valor_faturamento)) %>%
  mutate(codigo_empresa=fct_reorder(codigo_empresa, valor_faturamento)) %>%
  # drop_na() %>%
  head(10) %>%
  view()

Faturamento por codigo_empresa e st_grupocnae

Forecast

comparações

df3 <- df %>%
  group_by(data_safra) %>%
  summarize(valor_faturamento=sum(valor_faturamento))

train <- df3[1:28,]
test <- df3[29:36,]
test_ts <- test %>%
  rename(ds = data_safra, y = valor_faturamento) %>%
  subset(select = -c(y) )


train_ts <- train %>%
  rename(ds = data_safra, y = valor_faturamento)

model_arima <- auto.arima(train$valor_faturamento)
model_tbats <- tbats(train$valor_faturamento)
model_ets <- ets(train$valor_faturamento)
model_prophet <- prophet(train_ts)



f_arima <- forecast(model_arima, h=8)
f_tbats <- forecast(model_tbats, h=8)
f_ets <- forecast(model_ets, h=8)
f_naive <- naive(train$valor_faturamento, h=8)
f_meanf <- meanf(train$valor_faturamento, h=8)
f_rwf <- rwf(train$valor_faturamento, h=8)
# f_croston <- croston(train$valor_faturamento, h=8)
f_ses <- ses(train$valor_faturamento, h=8)
f_holt <- holt(train$valor_faturamento, h=8)
f_splinef <- splinef(train$valor_faturamento, h=8)
f_thetaf <- thetaf(train$valor_faturamento, h=8)
f_prophet <- predict(model_prophet, test_ts)


print(mae(test$valor_faturamento, f_arima$mean))
## [1] 4972.11
print(mae(test$valor_faturamento, f_tbats$mean))
## [1] 5502.643
print(mae(test$valor_faturamento, f_ets$mean))
## [1] 8891.716
print(mae(test$valor_faturamento, f_naive$mean))
## [1] 13025.21
print(mae(test$valor_faturamento, f_meanf$mean))
## [1] 47447.46
print(mae(test$valor_faturamento, f_rwf$mean))
## [1] 13025.21
# print(mae(test$valor_fatura4mento, f_croston$mean))
print(mae(test$valor_faturamento, f_ses$mean))
## [1] 16404.61
print(mae(test$valor_faturamento, f_holt$mean))
## [1] 8388.042
print(mae(test$valor_faturamento, f_splinef$mean))
## [1] 7270.132
print(mae(test$valor_faturamento, f_thetaf$mean))
## [1] 10908.08
print(mae(test$valor_faturamento, f_prophet$yhat))
## [1] 15862.43

TOTAL TBATS

df4 <- df %>%
  group_by(data_safra) %>%
  summarize(valor_faturamento=sum(valor_faturamento))

model2 <- bats(df4$valor_faturamento)

f2 <- forecast(model2, h=12)

dates <- rep(seq(as.Date('2019-01-01'), as.Date('2019-12-1'), by = 'months'), times = 1)

fcast <- data_frame("data_safra"=dates, "f_mean"=f2$mean,
                    "f_upper" = f2$upper[,2], "f_lower" = f2$lower[,2])

p <- ggplot(df4, aes(x=data_safra, y=valor_faturamento)) +
  geom_line(size=1) +
  geom_line(data=df4, aes(x=data_safra, y=valor_faturamento)) +
  geom_line(data=fcast, aes(x=data_safra, y=f_mean, color="Forecast")) +
  geom_line(data=fcast, aes(x=data_safra, y=f_lower, color="Lower"), linetype = "dotted") +
  geom_line(data=fcast, aes(x=data_safra, y=f_upper, color="Upper"), linetype = "dotted") +
  geom_smooth(data=df4, aes(x=data_safra, y=valor_faturamento),method = lm) +
  labs(x="Data", y="Faturamento") +
  scale_y_continuous(labels = dollar_format())

ggplotly(p)
#acf(model$residuals)

TOTAL ARIMA

df4 <- df %>%
  group_by(data_safra) %>%
  summarize(valor_faturamento=sum(valor_faturamento))

model2 <- auto.arima(df4$valor_faturamento)

f2 <- forecast(model2, h=12)

dates <- rep(seq(as.Date('2019-01-01'), as.Date('2019-12-1'), by = 'months'), times = 1)

fcast <- data_frame("data_safra"=dates, "f_mean"=f2$mean,
                    "f_upper" = f2$upper[,2], "f_lower" = f2$lower[,2])

p <- ggplot(df4, aes(x=data_safra, y=valor_faturamento)) +
  geom_line(size=1) +
  geom_line(data=df4, aes(x=data_safra, y=valor_faturamento)) +
  geom_line(data=fcast, aes(x=data_safra, y=f_mean, color="Forecast")) +
  geom_line(data=fcast, aes(x=data_safra, y=f_lower, color="Lower"), linetype = "dotted") +
  geom_line(data=fcast, aes(x=data_safra, y=f_upper, color="Upper"), linetype = "dotted") +
  labs(x="Data", y="Faturamento") +
  scale_y_continuous(labels = dollar_format())
ggplotly(p)

TOTAL PROPHET

df4 <- df %>%
  group_by(data_safra) %>%
  summarize(valor_faturamento=sum(valor_faturamento)) %>%
  rename(ds = data_safra, y = valor_faturamento)
  

model2 <- prophet(df4)

dates <- rep(seq(as.Date('2019-01-01'), as.Date('2019-12-1'), by = 'months'), times = 1)

ts <- data_frame("ds"=dates)


f2 <- predict(model2, ts)

fcast <- data_frame("data_safra"=dates, "f_mean"=f2$yhat,
                    "f_upper" = f2$yhat_upper, "f_lower" = f2$yhat_lower)

p <- ggplot(df4, aes(x=ds, y=y)) +
  geom_line(size=1) +
  geom_line(data=fcast, aes(x=data_safra, y=f_mean, color="Forecast")) +
  geom_line(data=fcast, aes(x=data_safra, y=f_lower, color="Lower"), linetype = "dotted") +
  geom_line(data=fcast, aes(x=data_safra, y=f_upper, color="Upper"), linetype = "dotted") +
  labs(x="Data", y="Faturamento") +
  scale_y_continuous(labels = dollar_format())
ggplotly(p)